{**routines to manipulate double linked lists}
unit lists;

interface
type
PList=^TList;
TList=Packed Record
Prev,Next: PList;
Data:pointer;
end;
function List_Add(var list:plist; element:pointer):PList;
procedure list_InsertBefore(var list,node:PList; const elem:pointer);
Procedure List_Remove(var list:plist; element:pointer; freedata:boolean=false);
procedure list_removenode(var list, node:PList);
function list_GetNode(const list:PList; index:cardinal):PList;
procedure List_Clear(var list:plist);
procedure List_FreeAll(var list:plist);
function List_Size(list:PList):cardinal;
function list_contains(l:plist; p:pointer):boolean;
procedure List_Merge(var list1:plist; var list2:plist);
type
TSearchProc=function( plistelement:pointer):boolean;
function List_ForAll(var list:plist; searchproc:TSearchProc):pointer;
function List_GetLast(list:plist):plist;

implementation
function List_GetLast(list:plist):plist;
begin
result:=list;
while result^.next <> nil do result:=result^.next;
end;

function List_Add(var list:plist; element:pointer):PList;
var temp:plist;
last:plist;
begin
if list=nil then begin
new(list);
list^.prev:=nil;
list^.next:=nil;
list^.data:=element;
result:=list;
exit;
end;
new(temp);
last:=List_GetLast(list);
temp^.prev:=last;
temp^.data:=element;
temp^.next:=nil;
last^.next:=temp;
result:=temp;
end;

procedure List_Remove(var list:plist; element:pointer; freedata:boolean=false);
var temp:plist;
begin
if list=nil then exit;
temp:=list;
while temp <> nil do if temp^.data=element  then break else temp:=temp^.next;
if temp=nil then exit;
if temp^.prev=nil then  list:=temp^.next else temp^.prev^.next:=temp^.next;
if temp^.next <> nil then temp^.next^.prev:=temp^.prev;
if freedata then freemem(temp^.data);
dispose(temp);
end;

function List_Size(list:PList):cardinal;
var p:plist;
begin
p:=list;
result:=0;
if p=nil then exit;
while p <> nil do begin p:=p^.next; inc(result); end;
end;

procedure List_Clear(var list:plist);
var temp:plist;
begin
if list=nil then exit;
temp:=list;
while list <> nil do begin
list:=list^.next;
freemem(temp);
temp:=list;
end;
end;

procedure List_FreeAll(var list:plist);
var temp:plist;
begin
if list=nil then exit;
temp:=list;
while list <> nil do begin
list:=list^.next;
if temp^.data <> nil then freemem(temp^.data);
freemem(temp);
temp:=list;
end;
end;

function List_ForAll(var list:plist; searchproc:TSearchProc):pointer;
var temp:plist;
begin
result:=nil;
temp:=list;
while temp <> nil do if searchproc(temp^.data) then break else temp:=temp^.next;
if temp <> nil then result:=temp^.data;
end;

procedure List_Merge(var list1:plist; var list2:plist);
var p:plist;
begin
p:=list2;
while p <> nil do begin if p^.data <> nil then List_Add(list1, p^.data); p:=p^.next; end;
end;
function list_contains(l:plist; p:pointer):boolean;
var ll:plist;
begin
result:=false;
ll:=l;
while ll <> nil do 
if ll^.data=p then begin
result:=true;
exit;
end else ll:=ll^.next;
end;

procedure list_removenode(var list, node:PList);
begin
if (list = nil) or (node = nil) then exit;
if node^.Prev <> nil then
node^.prev^.next:=node^.next;
if node^.Next <> nil then
node^.next^.prev:=node^.prev;
if list=node then list:=node^.next;
dispose(node);
end;

procedure list_InsertBefore(var list,node:PList; const elem:pointer);
var NewNode:PList;
begin
if list = nil then begin
list_add(list, elem);
exit;
end;
if node = nil then exit;
new(NewNode);
with NewNode^ do begin
Next := node;
Prev:=node^.Prev;
data:=elem;
end;
if node^.Prev <> nil then
node^.Prev^.Next:=NewNode;
Node^.Prev:=NewNode;
if list = node then list:=NewNode;
end;
function list_GetNode(const list:PList; index:cardinal):PList;
var PWalk:PList;
i:cardinal;
begin
result:=nil;
i:=0;
                            PWalk := list;
            while (PWalk<>nil) and (i < index) do begin
inc(i);
result:=PWalk;
PWalk := PWalk^.Next;
end;
end;
end.
